C     Program EX_0407.FOR
C     Listing 8F - see documentation in TUTOR.SSS
 
$include:'SSSF1.H'
 
      subroutine prime
$include:'SSSF2.H'
      logical opens, repars
      integer[c]
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
      real*8 inter, rept, n, d, r
      common opens, repars, inter, rept, n, d, r,
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
 
      ARRIVL = 1
      STARTA = 2
      ENDACT = 3
      NEXTAC = 4
      STRTDY = 5
      CLOSES = 0
      WATCH  = 1
 
      call INIQUE(0, 0, 3)
      call inista(1,'Night box           ', 1, 0, 0, 0)
      call inista(2,'W f repair          ', 1, 0, 0, 0)
      call inista(3,'W f delivery        ', 1, 0, 0, 0)
      call CREATE(0.0, WATCH )
      call CREATE(0.5, CLOSES)
      call SIMEND(10.0)
 
      n = 0
      r = 0
      d = 0

      opens  = .TRUE.
      repars = .FALSE.
      inter  = 7.0/25.0
      rept   = 2.0/24.0
      end
 
      subroutine clshop
$include:'SSSF2.H'
      logical opens, repars
      real*8 inter, rept, n, d, r
      integer[c]
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
      common opens, repars, inter, rept, n, d, r,
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
 
      opens = .FALSE.
      d = 0.0
      call TALLY(3, d)
      end
 
      subroutine box
$include:'SSSF2.H'
      logical opens, repars
      real*8 inter, rept, n, d, r
      integer[c]
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
      common opens, repars, inter, rept, n, d, r,
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
 
      call DISPOS
      n = n + 1.0
      call TALLY(1, n)
      end
 
      subroutine newday
$include:'SSSF2.H'
      logical opens, repars
      real*8 inter, rept, n, d, r
      integer[c]
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
      common opens, repars, inter, rept, n, d, r,
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
 
      call CREATE(0.5, CLOSES)
      call DISPOS
      opens  = .TRUE.
      repars = .FALSE.
      r = r + n
      call TALLY(2, r)
      n = 0.0
      call TALLY(1, n)
      end
 
      Program EX_0407
$include:'SSSF2.H'
      logical opens, repars
      real*8 inter, rept, n, d, r
      integer[c] ecode,
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
      common opens, repars, inter, rept, n, d, r,
     +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
     +CLOSES, WATCH
 
      call prime
   99 ecode = NEXTEV()
      if (ecode.gt.0) then
        goto (101, 102, 103, 104, 105) ecode
 
C ARRIVL
  101   continue
        if (IDE().eq.WATCH) then
          call CREATE(EX(inter), WATCH)
          call SCHED(0.0, NEXTAC, WATCH )
        else
          call SCHED(0.5, STRTDY, CLOSES)
          call clshop
        endif
        goto 99

C NEXTAC
  104   continue
        if (opens) then
          r = r + 1
          call TALLY(2, r)
          if (repars) then
            call DISPOS
          else
            call SCHED(0.0, STARTA, IDE())
          endif
 
        else
          call box
        endif
        goto 99
 
C STARTA
  102   continue
        call SCHED(EX(rept), ENDACT, 0)
        r = r - 1
        call TALLY(2, r)
        repars = .TRUE.
        goto 99
 
C ENDACT
  103   continue
        d = d + 1
        call TALLY(3, d)
        if (r.gt.0) then
          call SCHED(0.0, STARTA, 0)
        else
          call DISPOS
          repars = .FALSE.
        endif
        goto 99
 
C STRTDY
  105   continue
        call newday
        goto 99
 
      else
 
        call SUMRY('  ')
        stop 'End of simulation'
 
      endif
      end
